home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
mcedit10.zip
/
BOBMOUSE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-12-01
|
10KB
|
416 lines
UNIT BobMouse;
INTERFACE
USES DOS;
type
cursormasktype = ARRAY[0..1,0..15] of word;
var
cursormask : cursormasktype;
PROCEDURE MouseCall(VAR M1,M2,M3,M4 : Word); { general mouse function to }
{ make calls not included in }
{ this unit. }
FUNCTION IsLogitechMouse : Boolean; { Looks at driver }
PROCEDURE MouseReset; { Standard Mouse function call 0 }
FUNCTION GetNumberOfMouseButtons : Integer; { 0 }
PROCEDURE ShowMouse; { 1 }
PROCEDURE HideMouse; { 2 }
PROCEDURE PollMouse(VAR X,Y : Word;
VAR Left, Right, Both : Boolean); { 3 }
PROCEDURE MouseToXY(X,Y : Word); { 4 }
PROCEDURE SetColumnRange(High,Low : Word); { 7 }
PROCEDURE SetRowRange(High,Low : Word); { 8 }
PROCEDURE SetMouseGraphCursorTo(cursormask : cursormasktype;
x, y : integer);
PROCEDURE HandMouse; { 9 }
PROCEDURE WatchMouse;
PROCEDURE ConditionalOff(x1,y1,x2,y2: Word); { 16 }
FUNCTION MouseIsInstalled : Boolean;
FUNCTION GetMouseVersion : string; { 36 }
FUNCTION GetMouseType : string; { 36 }
FUNCTION GetMouseIRQ : string; { 36 }
{-------------------------------------------------------------------------}
IMPLEMENTATION
var
M1,M2,M3,M4 : Word;
{-------------------------------------------------------------------------}
PROCEDURE MouseCall(VAR M1,M2,M3,M4 : WORD);
VAR
Regs : registers;
BEGIN
WITH Regs DO
BEGIN
AX := M1; BX := M2; CX := M3; DX := M4
END;
Intr($33,Regs);
WITH Regs DO
BEGIN
M1 := AX; M2 := BX; M3 := CX; M4 := DX
END
END;
{-------------------------------------------------------------------------}
FUNCTION GetNumberOfMouseButtons : Integer;
BEGIN
M1 := 0; { Must reset mouse to count buttons! }
MouseCall(M1,M2,M3,M4);
GetNumberOfMouseButtons := M2
END;
{-------------------------------------------------------------------------}
FUNCTION MouseIsInstalled : Boolean;
TYPE
BytePtr = ^Byte;
VAR
TestVector : BytePtr;
BEGIN
GetIntVec(51,Pointer(TestVector));
{ $CF is the binary opcode for the IRET instruction; }
{ in many BIOSes, the startup code puts IRETs into }
{ most unused bectors. }
IF (TestVector = NIL) OR (TestVector^ = $CF) THEN
MouseIsInstalled := False
ELSE
MouseIsInstalled := True
END;
{-------------------------------------------------------------------------}
FUNCTION IsLogitechMouse : Boolean;
TYPE
Signature = ARRAY[0..13] OF Char;
SigPtr = ^Signature;
CONST LogitechSig : Signature = 'LOGITECH MOUSE';
VAR
TestVector : SigPtr;
L : LongInt;
BEGIN
GetIntVec(51,Pointer(TestVector));
LongInt(TestVector) := LongInt(TestVector) + 16;
IF TestVector^ = LogitechSig THEN
IsLogitechMouse := True
ELSE
IsLogitechMouse := False
END;
{-------------------------------------------------------------------------}
PROCEDURE MouseReset;
BEGIN
M1 := 0;
MouseCall(M1,M2,M3,M4);
END;
{-------------------------------------------------------------------------}
PROCEDURE ShowMouse;
BEGIN
M1 := 1;
MouseCall(M1,M2,M3,M4)
END;
{-------------------------------------------------------------------------}
PROCEDURE HideMouse;
BEGIN
M1 := 2;
MouseCall(M1,M2,M3,M4)
END;
{-------------------------------------------------------------------------}
PROCEDURE PollMouse(VAR X,Y : Word; VAR Left,Right,Both : Boolean);
BEGIN
M1 := 3; { Perform mouse function call 3 }
MouseCall(M1,M2,M3,M4);
X := M3; Y := M4; { Return mouse pointer X,Y position }
IF (M2 AND $01) = $01 THEN Left := True ELSE Left := False;
IF (M2 AND $02) = $02 THEN Right := True ELSE Right := False;
IF (M2 AND $04) = $03 THEN Both := True ELSE Both := False;
END;
{-------------------------------------------------------------------------}
PROCEDURE MouseToXY(X,Y : Word);
BEGIN
M1 := 4;
M3 := X; M4 := Y;
MouseCall(M1,M2,M3,M4)
END;
{-------------------------------------------------------------------------}
PROCEDURE SetColumnRange(High,Low : Word);
BEGIN
M1 := 7;
M3 := Low;
M4 := High;
MouseCall(M1,M2,M3,M4)
END;
{-------------------------------------------------------------------------}
PROCEDURE SetRowRange(High,Low : Word);
BEGIN
M1 := 8;
M3 := Low;
M4 := High;
MouseCall(M1,M2,M3,M4)
END;
{-------------------------------------------------------------------------}
PROCEDURE SetMouseGraphCursorTo(cursormask : cursormasktype; x, y : integer);
var
Regs : Registers;
BEGIN
M1 := 9;
M2 := x;
M3 := y;
regs.DX := ofs(cursormask);
regs.ES := seg(cursormask);
WITH Regs DO
BEGIN
AX := M1; BX := M2; CX := M3;
END;
Intr(51,Regs);
END;
{-------------------------------------------------------------------------}
PROCEDURE ConditionalOff(x1,y1,x2,y2: Word); { 16 }
var
Regs : Registers;
BEGIN
WITH Regs DO
BEGIN
AX := 16; CX := x1; DX := y1; SI := x2; DI := y2;
END;
Intr(51,Regs);
END;
{-------------------------------------------------------------------------}
FUNCTION GetMouseVersion : string; {36}
var
verdec : integer;
s : string;
function IntToHex(IntNum: Integer): String;
const
HexChars: array[0..15] of char = '0123456789ABCDEF';
var
Temp : byte;
TempStr : string[2];
begin
Temp := hi(intNum);
TempStr := HexChars[Temp shr 4] + HexChars[Temp and $0F];
Temp := lo(intNum);
IntToHex := TempStr + HexChars[Temp shr 4] + HexChars[Temp and $0F];
end;
BEGIN
M1 := 36;
MouseCall(M1,M2,M3,M4);
verdec := M2;
s := IntToHex(verdec);
Insert('.',s,3);
if s[1] = '0' then s := Copy(s,2,4);
GetMouseVersion := s;
END;
{-------------------------------------------------------------------------}
FUNCTION GetMouseType : string; {36}
var
Mtype : byte;
BEGIN
M1 := 36;
MouseCall(M1,M2,M3,M4);
Mtype := hi(M3);
case Mtype of
1 : GetMouseType := 'bus mouse';
2 : GetMouseType := 'serial mouse';
3 : GetMouseType := 'InPort mouse';
4 : GetMouseType := 'PS/2 mouse';
5 : GetMouseType := 'Hewlett-Packard mouse';
else
GetMouseType := 'unknown mouse';
end; {case}
if IsLogitechMouse then GetMouseType := 'Logitech mouse';
END;
{-------------------------------------------------------------------------}
FUNCTION GetMouseIRQ : string; {36}
var
IRQnumber : byte;
BEGIN
M1 := 36;
MouseCall(M1,M2,M3,M4);
IRQnumber := lo(M3);
case IRQnumber of
0 : GetMouseIRQ := 'PS/2';
2 : GetMouseIRQ := '2';
3 : GetMouseIRQ := '3';
4 : GetMouseIRQ := '4';
5 : GetMouseIRQ := '5';
7 : GetMouseIRQ := '7';
else
GetMouseIRQ := 'unable to determin IRQ';
end; {case}
END;
{-------------------------------------------------------------------------}
PROCEDURE HandMouse;
var
handmasks : array[0..1,0..15] of word;
Regs : Registers;
BEGIN
handmasks[0,0] := $0;
handmasks[0,1] := $0;
handmasks[0,2] := $0;
handmasks[0,3] := $0;
handmasks[0,4] := $0;
handmasks[0,5] := $0;
handmasks[0,6] := $0;
handmasks[0,7] := $0;
handmasks[0,8] := $0;
handmasks[0,9] := $0;
handmasks[0,10] := $0;
handmasks[0,11] := $0;
handmasks[0,12] := $0;
handmasks[0,13] := $0;
handmasks[0,14] := $0;
handmasks[0,15] := $0;
handmasks[1,0] := $0;
handmasks[1,1] := $0;
handmasks[1,2] := $0;
handmasks[1,3] := $0;
handmasks[1,4] := $0;
handmasks[1,5] := $0;
handmasks[1,6] := $0;
handmasks[1,7] := $0;
handmasks[1,8] := $0;
handmasks[1,9] := $0;
handmasks[1,10] := $0;
handmasks[1,11] := $0;
handmasks[1,12] := $0;
handmasks[1,13] := $0;
handmasks[1,14] := $0;
handmasks[1,15] := $0;
M1 := 9;
M2 := 8;
M3 := 8;
regs.DX := ofs(handmasks);
regs.ES := seg(handmasks);
WITH Regs DO
BEGIN
AX := M1; BX := M2; CX := M3;
END;
Intr(51,Regs);
END;
{-------------------------------------------------------------------------}
PROCEDURE WatchMouse;
var
watch : array[0..1,0..15] of word;
Regs : Registers;
BEGIN
watch[0,0] := $FFFF;
watch[0,1] := $F00F;
watch[0,2] := $F00F;
watch[0,3] := $F00F;
watch[0,4] := $F00F;
watch[0,5] := $C003;
watch[0,6] := $8001;
watch[0,7] := $0;
watch[0,8] := $0;
watch[0,9] := $0;
watch[0,10] := $8001;
watch[0,11] := $C003;
watch[0,12] := $F00F;
watch[0,13] := $F00F;
watch[0,14] := $F00F;
watch[0,15] := $F00F;
watch[1,0] := $0;
watch[1,1] := $5A0;
watch[1,2] := $5A0;
watch[1,3] := $420;
watch[1,4] := $3C0;
watch[1,5] := $FF0;
watch[1,6] := $3E7C;
watch[1,7] := $7E7E;
watch[1,8] := $7E02;
watch[1,9] := $7FFE;
watch[1,10] := $3FFC;
watch[1,11] := $FF0;
watch[1,12] := $3C0;
watch[1,13] := $420;
watch[1,14] := $5A0;
watch[1,15] := $5A0;
M1 := 9;
M2 := 8;
M3 := 0;
regs.DX := ofs(WATCH);
regs.ES := seg(WATCH);
WITH Regs DO
BEGIN
AX := M1; BX := M2; CX := M3;
END;
Intr(51,Regs);
END;
{-------------------------------------------------------------------------}
BEGIN
END. {Mouse}